home *** CD-ROM | disk | FTP | other *** search
/ Gigarom 1 / Gigarom Macintosh Archives (Quantum Leap)(CDRM1080320)(1993).iso / FILES / DEV / I-Z / Xlisp_Source.cpt / xlisp.h < prev    next >
Text File  |  1985-04-08  |  7KB  |  266 lines
  1. /* xlisp - a small subset of lisp */
  2.  
  3. /* system specific definitions */
  4. #define MEGAMAX
  5.  
  6. #ifdef AZTEC
  7. #include "stdio.h"
  8. #include "setjmp.h"
  9. #else
  10. #include <stdio.h>
  11. #include <setjmp.h>
  12. #include <ctype.h>
  13. #endif
  14.  
  15. /* NNODES    number of nodes to allocate in each request */
  16. /* TDEPTH    trace stack depth */
  17. /* FORWARD    type of a forward declaration (usually "") */
  18. /* LOCAL    type of a local function (usually "static") */
  19.  
  20. /* for the Computer Innovations compiler */
  21. #ifdef CI
  22. #define NNODES        1000
  23. #define TDEPTH        500
  24. #endif
  25.  
  26. /* for the CPM68K compiler */
  27. #ifdef CPM68K
  28. #define NNODES        1000
  29. #define TDEPTH        500
  30. #define LOCAL
  31. #define AFMT        "%lx"
  32. /* ************ MegaMax Bug!! ************
  33. #undef NULL
  34. #define NULL        (char *)0
  35.    *************************************** */
  36. #endif
  37.  
  38. /* for the DeSmet compiler */
  39. #ifdef DESMET
  40. #define NNODES        1000
  41. #define TDEPTH        500
  42. #define LOCAL
  43. #define getc(fp)    getcx(fp)
  44. #define putc(ch,fp)    putcx(ch,fp)
  45. #define EOF        -1
  46. #endif
  47.  
  48. /* for the MegaMax compiler */
  49. #ifdef MEGAMAX
  50. #define NNODES        200
  51. #define TDEPTH        100
  52. #define LOCAL
  53. #define AFMT        "%lx"
  54. #define TSTKSIZE    (4 * TDEPTH)
  55. #define getc(fp)    macgetc(fp)
  56. #define putc(ch,fp)    macputc(ch,fp)
  57. #endif
  58.  
  59. /* for the VAX-11 C compiler */
  60. #ifdef vms
  61. #define NNODES        2000
  62. #define TDEPTH        1000
  63. #endif
  64.  
  65. /* for the DECUS C compiler */
  66. #ifdef decus
  67. #define NNODES        200
  68. #define TDEPTH        100
  69. #define FORWARD        extern
  70. #endif
  71.  
  72. /* for unix compilers */
  73. #ifdef unix
  74. #define NNODES        200
  75. #define TDEPTH        100
  76. #endif
  77.  
  78. /* for the AZTEC C compiler */
  79. #ifdef AZTEC
  80. #define NNODES        200
  81. #define TDEPTH        100
  82. #define getc(fp)    agetc(fp)
  83. #define putc(ch,fp)    aputc(ch,fp)
  84. #endif
  85.  
  86. /* default important definitions */
  87. #ifndef NNODES
  88. #define NNODES        200
  89. #endif
  90. #ifndef TDEPTH
  91. #define TDEPTH        100
  92. #endif
  93. #ifndef FORWARD
  94. #define FORWARD
  95. #endif
  96. #ifndef LOCAL
  97. #define LOCAL        static
  98. #endif
  99. #ifndef AFMT
  100. #define AFMT        "%x"
  101. #endif
  102. /* ************ MegaMax Bug!! ************
  103. #ifndef TSTKSIZE
  104. #define TSTKSIZE    (sizeof(NODE *) * TDEPTH)
  105.    *************************************** */
  106. #endif
  107.  
  108. /* useful definitions */
  109. #define TRUE    1
  110. #define FALSE    0
  111. #define NIL    (NODE *)0
  112.  
  113. /* program limits */
  114. #define STRMAX        100        /* maximum length of a string constant */
  115.     
  116. /* node types */
  117. #define FREE    0
  118. #define SUBR    1
  119. #define FSUBR    2
  120. #define LIST    3
  121. #define SYM    4
  122. #define INT    5
  123. #define STR    6
  124. #define OBJ    7
  125. #define FPTR    8
  126.  
  127. /* node flags */
  128. #define MARK    1
  129. #define LEFT    2
  130.  
  131. /* string types */
  132. #define DYNAMIC    0
  133. #define STATIC    1
  134.  
  135. /* new node access macros */
  136. #define ntype(x)    ((x)->n_type)
  137. #define atom(x)        ((x) == NIL || (x)->n_type != LIST)
  138. #define null(x)        ((x) == NIL)
  139. #define listp(x)    ((x) == NIL || (x)->n_type == LIST)
  140. #define consp(x)    ((x) && (x)->n_type == LIST)
  141. #define subrp(x)    ((x) && (x)->n_type == SUBR)
  142. #define fsubrp(x)    ((x) && (x)->n_type == FSUBR)
  143. #define stringp(x)    ((x) && (x)->n_type == STR)
  144. #define symbolp(x)    ((x) && (x)->n_type == SYM)
  145. #define filep(x)    ((x) && (x)->n_type == FPTR)
  146. #define objectp(x)    ((x) && (x)->n_type == OBJ)
  147. #define fixp(x)        ((x) && (x)->n_type == INT)
  148. #define car(x)        ((x)->n_car)
  149. #define cdr(x)        ((x)->n_cdr)
  150. #define rplaca(x,y)    ((x)->n_car = (y))
  151. #define rplacd(x,y)    ((x)->n_cdr = (y))
  152.  
  153. /* symbol node */
  154. #define n_symplist    n_info.n_xsym.xsy_plist
  155. #define n_symvalue    n_info.n_xsym.xsy_value
  156.  
  157. /* subr/fsubr node */
  158. #define n_subr        n_info.n_xsubr.xsu_subr
  159.  
  160. /* list node */
  161. #define n_car        n_info.n_xlist.xl_car
  162. #define n_cdr        n_info.n_xlist.xl_cdr
  163. #define n_ptr        n_info.n_xlist.xl_car
  164.  
  165. /* integer node */
  166. #define n_int        n_info.n_xint.xi_int
  167.  
  168. /* string node */
  169. #define n_str        n_info.n_xstr.xst_str
  170. #define n_strtype    n_info.n_xstr.xst_type
  171.  
  172. /* object node */
  173. #define n_obclass    n_info.n_xobj.xo_obclass
  174. #define n_obdata    n_info.n_xobj.xo_obdata
  175.  
  176. /* file pointer node */
  177. #define n_fp        n_info.n_xfptr.xf_fp
  178. #define n_savech    n_info.n_xfptr.xf_savech
  179.  
  180. /* node structure */
  181. typedef struct node {
  182.     char n_type;        /* type of node */
  183.     char n_flags;        /* flag bits */
  184.     union {            /* value */
  185.     struct xsym {        /* symbol node */
  186.         struct node *xsy_plist;    /* symbol plist - (name . plist) */
  187.         struct node *xsy_value;    /* the current value */
  188.     } n_xsym;
  189.     struct xsubr {        /* subr/fsubr node */
  190.         struct node *(*xsu_subr)();    /* pointer to an internal routine */
  191.     } n_xsubr;
  192.     struct xlist {        /* list node (cons) */
  193.         struct node *xl_car;    /* the car pointer */
  194.         struct node *xl_cdr;    /* the cdr pointer */
  195.     } n_xlist;
  196.     struct xint {        /* integer node */
  197.         int xi_int;            /* integer value */
  198.     } n_xint;
  199.     struct xstr {        /* string node */
  200.         int xst_type;        /* string type */
  201.         char *xst_str;        /* string pointer */
  202.     } n_xstr;
  203.     struct xobj {        /* object node */
  204.         struct node *xo_obclass;    /* class of object */
  205.         struct node *xo_obdata;    /* instance data */
  206.     } n_xobj;
  207.     struct xfptr {        /* file pointer node */
  208.         FILE *xf_fp;        /* the file pointer */
  209.         int xf_savech;        /* lookahead character for input files */
  210.     } n_xfptr;
  211.     } n_info;
  212. } NODE;
  213.  
  214. /* execution context flags */
  215. #define CF_GO        1
  216. #define CF_RETURN    2
  217. #define CF_THROW    4
  218. #define CF_ERROR    8
  219.  
  220. /* execution context */
  221. typedef struct context {
  222.     int c_flags;            /* context type flags */
  223.     struct node *c_expr;        /* expression (type dependant) */
  224.     jmp_buf c_jmpbuf;            /* longjmp context */
  225.     struct context *c_xlcontext;    /* old value of xlcontext */
  226.     struct node *c_xlstack;        /* old value of xlstack */
  227.     struct node *c_xlenv,*c_xlnewenv;    /* old values of xlenv and xlnewenv */
  228.     int c_xltrace;            /* old value of xltrace */
  229. } CONTEXT;
  230.  
  231. /* function table entry structure */
  232. struct fdef {
  233.     char *f_name;            /* function name */
  234.     int f_type;                /* function type SUBR/FSUBR */
  235.     struct node *(*f_fcn)();        /* function code */
  236. };
  237.  
  238. /* memory segment structure definition */
  239. struct segment {
  240.     int sg_size;
  241.     struct segment *sg_next;
  242.     struct node sg_nodes[1];
  243. };
  244.  
  245. /* external procedure declarations */
  246. extern struct node *xleval();        /* evaluate an expression */
  247. extern struct node *xlapply();        /* apply a function to arguments */
  248. extern struct node *xlevlist();        /* evaluate a list of arguments */
  249. extern struct node *xlarg();        /* fetch an argument */
  250. extern struct node *xlevarg();        /* fetch and evaluate an argument */
  251. extern struct node *xlmatch();        /* fetch an typed argument */
  252. extern struct node *xlevmatch();    /* fetch and evaluate a typed arg */
  253. extern struct node *xlsend();        /* send a message to an object */
  254. extern struct node *xlenter();        /* enter a symbol */
  255. extern struct node *xlsenter();        /* enter a symbol with a static pname */
  256. extern struct node *xlmakesym();    /* make an uninterned symbol */
  257. extern struct node *xlsave();        /* generate a stack frame */
  258. extern struct node *xlobsym();        /* find an object's class or instance
  259.                        variable */
  260. extern struct node *xlgetprop();    /* get the value of a property */
  261. extern char *xlsymname();        /* get the print name of a symbol */
  262.  
  263. extern struct node *newnode();        /* allocate a new node */
  264. extern char *stralloc();        /* allocate string space */
  265. extern char *strsave();            /* make a safe copy of a string */
  266.